home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / UNIXTOOL / GNU / PERL / PERL5SRC.ZIP / !Perl / c / util < prev   
Text File  |  1995-06-28  |  34KB  |  1,715 lines
  1. /*    util.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "Very useful, no doubt, that was to Saruman; yet it seems that he was
  12.  * not content."  --Gandalf
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #include "perl.h"
  17.  
  18. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  19. #include <signal.h>
  20. #endif
  21.  
  22. #ifdef I_UNISTD
  23. #  include <unistd.h>
  24. #endif
  25.  
  26. #ifdef I_VFORK
  27. #  include <vfork.h>
  28. #endif
  29.  
  30. /* Put this after #includes because fork and vfork prototypes may
  31.    conflict.
  32. */
  33. #ifndef HAS_VFORK
  34. #   define vfork fork
  35. #endif
  36.  
  37. #ifdef I_FCNTL
  38. #  include <fcntl.h>
  39. #endif
  40. #ifdef I_SYS_FILE
  41. #  include <sys/file.h>
  42. #endif
  43.  
  44. #define FLUSH
  45.  
  46. #ifdef LEAKTEST
  47. static void xstat _((void));
  48. #endif
  49.  
  50. #ifndef safemalloc
  51.  
  52. /* paranoid version of malloc */
  53.  
  54. /* NOTE:  Do not call the next three routines directly.  Use the macros
  55.  * in handy.h, so that we can easily redefine everything to do tracking of
  56.  * allocated hunks back to the original New to track down any memory leaks.
  57.  */
  58.  
  59. char *
  60. safemalloc(size)
  61. #ifdef MSDOS
  62. unsigned long size;
  63. #else
  64. MEM_SIZE size;
  65. #endif /* MSDOS */
  66. {
  67.     char  *ptr;
  68. #ifdef MSDOS
  69.     if (size > 0xffff) {
  70.         fprintf(stderr, "Allocation too large: %lx\n", size) FLUSH;
  71.         my_exit(1);
  72.     }
  73. #endif /* MSDOS */
  74. #ifdef DEBUGGING
  75.     if ((long)size < 0)
  76.     croak("panic: malloc");
  77. #endif
  78.     ptr = malloc(size?size:1);    /* malloc(0) is NASTY on our system */
  79. #if !(defined(I286) || defined(atarist))
  80.     DEBUG_m(fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
  81. #else
  82.     DEBUG_m(fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
  83. #endif
  84.     if (ptr != Nullch)
  85.     return ptr;
  86.     else if (nomemok)
  87.     return Nullch;
  88.     else {
  89.     fputs(no_mem,stderr) FLUSH;
  90.     my_exit(1);
  91.     }
  92.     /*NOTREACHED*/
  93. }
  94.  
  95. /* paranoid version of realloc */
  96.  
  97. char *
  98. saferealloc(where,size)
  99. char *where;
  100. #ifndef MSDOS
  101. MEM_SIZE size;
  102. #else
  103. unsigned long size;
  104. #endif /* MSDOS */
  105. {
  106.     char *ptr;
  107. #if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE)
  108.     char *realloc();
  109. #endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */
  110.  
  111. #ifdef MSDOS
  112.     if (size > 0xffff) {
  113.         fprintf(stderr, "Reallocation too large: %lx\n", size) FLUSH;
  114.         my_exit(1);
  115.     }
  116. #endif /* MSDOS */
  117.     if (!where)
  118.     croak("Null realloc");
  119. #ifdef DEBUGGING
  120.     if ((long)size < 0)
  121.     croak("panic: realloc");
  122. #endif
  123.     ptr = realloc(where,size?size:1);    /* realloc(0) is NASTY on our system */
  124.  
  125. #if !(defined(I286) || defined(atarist))
  126.     DEBUG_m( {
  127.     fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
  128.     fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
  129.     } )
  130. #else
  131.     DEBUG_m( {
  132.     fprintf(stderr,"0x%lx: (%05d) rfree\n",where,an++);
  133.     fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
  134.     } )
  135. #endif
  136.  
  137.     if (ptr != Nullch)
  138.     return ptr;
  139.     else if (nomemok)
  140.     return Nullch;
  141.     else {
  142.     fputs(no_mem,stderr) FLUSH;
  143.     my_exit(1);
  144.     }
  145.     /*NOTREACHED*/
  146. }
  147.  
  148. /* safe version of free */
  149.  
  150. void
  151. safefree(where)
  152. char *where;
  153. {
  154. #if !(defined(I286) || defined(atarist))
  155.     DEBUG_m( fprintf(stderr,"0x%x: (%05d) free\n",where,an++));
  156. #else
  157.     DEBUG_m( fprintf(stderr,"0x%lx: (%05d) free\n",where,an++));
  158. #endif
  159.     if (where) {
  160.     /*SUPPRESS 701*/
  161.     free(where);
  162.     }
  163. }
  164.  
  165. #endif /* !safemalloc */
  166.  
  167. #ifdef LEAKTEST
  168.  
  169. #define ALIGN sizeof(long)
  170.  
  171. char *
  172. safexmalloc(x,size)
  173. I32 x;
  174. MEM_SIZE size;
  175. {
  176.     register char *where;
  177.  
  178.     where = safemalloc(size + ALIGN);
  179.     xcount[x]++;
  180.     where[0] = x % 100;
  181.     where[1] = x / 100;
  182.     return where + ALIGN;
  183. }
  184.  
  185. char *
  186. safexrealloc(where,size)
  187. char *where;
  188. MEM_SIZE size;
  189. {
  190.     register char *new = saferealloc(where - ALIGN, size + ALIGN);
  191.     return new + ALIGN;
  192. }
  193.  
  194. void
  195. safexfree(where)
  196. char *where;
  197. {
  198.     I32 x;
  199.  
  200.     if (!where)
  201.     return;
  202.     where -= ALIGN;
  203.     x = where[0] + 100 * where[1];
  204.     xcount[x]--;
  205.     safefree(where);
  206. }
  207.  
  208. static void
  209. xstat()
  210. {
  211.     register I32 i;
  212.  
  213.     for (i = 0; i < MAXXCOUNT; i++) {
  214.     if (xcount[i] > lastxcount[i]) {
  215.         fprintf(stderr,"%2d %2d\t%ld\n", i / 100, i % 100, xcount[i]);
  216.         lastxcount[i] = xcount[i];
  217.     }
  218.     }
  219. }
  220.  
  221. #endif /* LEAKTEST */
  222.  
  223. /* copy a string up to some (non-backslashed) delimiter, if any */
  224.  
  225. char *
  226. cpytill(to,from,fromend,delim,retlen)
  227. register char *to;
  228. register char *from;
  229. register char *fromend;
  230. register int delim;
  231. I32 *retlen;
  232. {
  233.     char *origto = to;
  234.  
  235.     for (; from < fromend; from++,to++) {
  236.     if (*from == '\\') {
  237.         if (from[1] == delim)
  238.         from++;
  239.         else if (from[1] == '\\')
  240.         *to++ = *from++;
  241.     }
  242.     else if (*from == delim)
  243.         break;
  244.     *to = *from;
  245.     }
  246.     *to = '\0';
  247.     *retlen = to - origto;
  248.     return from;
  249. }
  250.  
  251. /* return ptr to little string in big string, NULL if not found */
  252. /* This routine was donated by Corey Satten. */
  253.  
  254. char *
  255. instr(big, little)
  256. register char *big;
  257. register char *little;
  258. {
  259.     register char *s, *x;
  260.     register I32 first;
  261.  
  262.     if (!little)
  263.     return big;
  264.     first = *little++;
  265.     if (!first)
  266.     return big;
  267.     while (*big) {
  268.     if (*big++ != first)
  269.         continue;
  270.     for (x=big,s=little; *s; /**/ ) {
  271.         if (!*x)
  272.         return Nullch;
  273.         if (*s++ != *x++) {
  274.         s--;
  275.         break;
  276.         }
  277.     }
  278.     if (!*s)
  279.         return big-1;
  280.     }
  281.     return Nullch;
  282. }
  283.  
  284. /* same as instr but allow embedded nulls */
  285.  
  286. char *
  287. ninstr(big, bigend, little, lend)
  288. register char *big;
  289. register char *bigend;
  290. char *little;
  291. char *lend;
  292. {
  293.     register char *s, *x;
  294.     register I32 first = *little;
  295.     register char *littleend = lend;
  296.  
  297.     if (!first && little >= littleend)
  298.     return big;
  299.     if (bigend - big < littleend - little)
  300.     return Nullch;
  301.     bigend -= littleend - little++;
  302.     while (big <= bigend) {
  303.     if (*big++ != first)
  304.         continue;
  305.     for (x=big,s=little; s < littleend; /**/ ) {
  306.         if (*s++ != *x++) {
  307.         s--;
  308.         break;
  309.         }
  310.     }
  311.     if (s >= littleend)
  312.         return big-1;
  313.     }
  314.     return Nullch;
  315. }
  316.  
  317. /* reverse of the above--find last substring */
  318.  
  319. char *
  320. rninstr(big, bigend, little, lend)
  321. register char *big;
  322. char *bigend;
  323. char *little;
  324. char *lend;
  325. {
  326.     register char *bigbeg;
  327.     register char *s, *x;
  328.     register I32 first = *little;
  329.     register char *littleend = lend;
  330.  
  331.     if (!first && little >= littleend)
  332.     return bigend;
  333.     bigbeg = big;
  334.     big = bigend - (littleend - little++);
  335.     while (big >= bigbeg) {
  336.     if (*big-- != first)
  337.         continue;
  338.     for (x=big+2,s=little; s < littleend; /**/ ) {
  339.         if (*s++ != *x++) {
  340.         s--;
  341.         break;
  342.         }
  343.     }
  344.     if (s >= littleend)
  345.         return big+1;
  346.     }
  347.     return Nullch;
  348. }
  349.  
  350. void
  351. fbm_compile(sv, iflag)
  352. SV *sv;
  353. I32 iflag;
  354. {
  355.     register unsigned char *s;
  356.     register unsigned char *table;
  357.     register U32 i;
  358.     register U32 len = SvCUR(sv);
  359.     I32 rarest = 0;
  360.     U32 frequency = 256;
  361.  
  362.     if (len > 255)
  363.     return;            /* can't have offsets that big */
  364.     Sv_Grow(sv,len+258);
  365.     table = (unsigned char*)(SvPVX(sv) + len + 1);
  366.     s = table - 2;
  367.     for (i = 0; i < 256; i++) {
  368.     table[i] = len;
  369.     }
  370.     i = 0;
  371.     while (s >= (unsigned char*)(SvPVX(sv)))
  372.     {
  373.     if (table[*s] == len) {
  374. #ifndef pdp11
  375.         if (iflag)
  376.         table[*s] = table[fold[*s]] = i;
  377. #else
  378.         if (iflag) {
  379.         I32 j;
  380.         j = fold[*s];
  381.         table[j] = i;
  382.         table[*s] = i;
  383.         }
  384. #endif /* pdp11 */
  385.         else
  386.         table[*s] = i;
  387.     }
  388.     s--,i++;
  389.     }
  390.     sv_upgrade(sv, SVt_PVBM);
  391.     sv_magic(sv, Nullsv, 'B', Nullch, 0);            /* deep magic */
  392.     SvVALID_on(sv);
  393.  
  394.     s = (unsigned char*)(SvPVX(sv));        /* deeper magic */
  395.     if (iflag) {
  396.     register U32 tmp, foldtmp;
  397.     SvCASEFOLD_on(sv);
  398.     for (i = 0; i < len; i++) {
  399.         tmp=freq[s[i]];
  400.         foldtmp=freq[fold[s[i]]];
  401.         if (tmp < frequency && foldtmp < frequency) {
  402.         rarest = i;
  403.         /* choose most frequent among the two */
  404.         frequency = (tmp > foldtmp) ? tmp : foldtmp;
  405.         }
  406.     }
  407.     }
  408.     else {
  409.     for (i = 0; i < len; i++) {
  410.         if (freq[s[i]] < frequency) {
  411.         rarest = i;
  412.         frequency = freq[s[i]];
  413.         }
  414.     }
  415.     }
  416.     BmRARE(sv) = s[rarest];
  417.     BmPREVIOUS(sv) = rarest;
  418.     DEBUG_r(fprintf(stderr,"rarest char %c at %d\n",BmRARE(sv),BmPREVIOUS(sv)));
  419. }
  420.  
  421. char *
  422. fbm_instr(big, bigend, littlestr)
  423. unsigned char *big;
  424. register unsigned char *bigend;
  425. SV *littlestr;
  426. {
  427.     register unsigned char *s;
  428.     register I32 tmp;
  429.     register I32 littlelen;
  430.     register unsigned char *little;
  431.     register unsigned char *table;
  432.     register unsigned char *olds;
  433.     register unsigned char *oldlittle;
  434.  
  435.     if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
  436.     STRLEN len;
  437.     char *l = SvPV(littlestr,len);
  438.     if (!len)
  439.         return (char*)big;
  440.     return ninstr((char*)big,(char*)bigend, l, l + len);
  441.     }
  442.  
  443.     littlelen = SvCUR(littlestr);
  444.     if (SvTAIL(littlestr) && !multiline) {    /* tail anchored? */
  445.     if (littlelen > bigend - big)
  446.         return Nullch;
  447.     little = (unsigned char*)SvPVX(littlestr);
  448.     if (SvCASEFOLD(littlestr)) {    /* oops, fake it */
  449.         big = bigend - littlelen;        /* just start near end */
  450.         if (bigend[-1] == '\n' && little[littlelen-1] != '\n')
  451.         big--;
  452.     }
  453.     else {
  454.         s = bigend - littlelen;
  455.         if (*s == *little && bcmp((char*)s,(char*)little,littlelen)==0)
  456.         return (char*)s;        /* how sweet it is */
  457.         else if (bigend[-1] == '\n' && little[littlelen-1] != '\n'
  458.           && s > big) {
  459.             s--;
  460.         if (*s == *little && bcmp((char*)s,(char*)little,littlelen)==0)
  461.             return (char*)s;
  462.         }
  463.         return Nullch;
  464.     }
  465.     }
  466.     table = (unsigned char*)(SvPVX(littlestr) + littlelen + 1);
  467.     if (--littlelen >= bigend - big)
  468.     return Nullch;
  469.     s = big + littlelen;
  470.     oldlittle = little = table - 2;
  471.     if (SvCASEFOLD(littlestr)) {    /* case insensitive? */
  472.     if (s < bigend) {
  473.       top1:
  474.         /*SUPPRESS 560*/
  475.         if (tmp = table[*s]) {
  476. #ifdef POINTERRIGOR
  477.         if (bigend - s > tmp) {
  478.             s += tmp;
  479.             goto top1;
  480.         }
  481. #else
  482.         if ((s += tmp) < bigend)
  483.             goto top1;
  484. #endif
  485.         return Nullch;
  486.         }
  487.         else {
  488.         tmp = littlelen;    /* less expensive than calling strncmp() */
  489.         olds = s;
  490.         while (tmp--) {
  491.             if (*--s == *--little || fold[*s] == *little)
  492.             continue;
  493.             s = olds + 1;    /* here we pay the price for failure */
  494.             little = oldlittle;
  495.             if (s < bigend)    /* fake up continue to outer loop */
  496.             goto top1;
  497.             return Nullch;
  498.         }
  499.         return (char *)s;
  500.         }
  501.     }
  502.     }
  503.     else {
  504.     if (s < bigend) {
  505.       top2:
  506.         /*SUPPRESS 560*/
  507.         if (tmp = table[*s]) {
  508. #ifdef POINTERRIGOR
  509.         if (bigend - s > tmp) {
  510.             s += tmp;
  511.             goto top2;
  512.         }
  513. #else
  514.         if ((s += tmp) < bigend)
  515.             goto top2;
  516. #endif
  517.         return Nullch;
  518.         }
  519.         else {
  520.         tmp = littlelen;    /* less expensive than calling strncmp() */
  521.         olds = s;
  522.         while (tmp--) {
  523.             if (*--s == *--little)
  524.             continue;
  525.             s = olds + 1;    /* here we pay the price for failure */
  526.             little = oldlittle;
  527.             if (s < bigend)    /* fake up continue to outer loop */
  528.             goto top2;
  529.             return Nullch;
  530.         }
  531.         return (char *)s;
  532.         }
  533.     }
  534.     }
  535.     return Nullch;
  536. }
  537.  
  538. char *
  539. screaminstr(bigstr, littlestr)
  540. SV *bigstr;
  541. SV *littlestr;
  542. {
  543.     register unsigned char *s, *x;
  544.     register unsigned char *big;
  545.     register I32 pos;
  546.     register I32 previous;
  547.     register I32 first;
  548.     register unsigned char *little;
  549.     register unsigned char *bigend;
  550.     register unsigned char *littleend;
  551.  
  552.     if ((pos = screamfirst[BmRARE(littlestr)]) < 0)
  553.     return Nullch;
  554.     little = (unsigned char *)(SvPVX(littlestr));
  555.     littleend = little + SvCUR(littlestr);
  556.     first = *little++;
  557.     previous = BmPREVIOUS(littlestr);
  558.     big = (unsigned char *)(SvPVX(bigstr));
  559.     bigend = big + SvCUR(bigstr);
  560.     while (pos < previous) {
  561.     if (!(pos += screamnext[pos]))
  562.         return Nullch;
  563.     }
  564. #ifdef POINTERRIGOR
  565.     if (SvCASEFOLD(littlestr)) {    /* case insignificant? */
  566.     do {
  567.         if (big[pos-previous] != first && big[pos-previous] != fold[first])
  568.         continue;
  569.         for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
  570.         if (x >= bigend)
  571.             return Nullch;
  572.         if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
  573.             s--;
  574.             break;
  575.         }
  576.         }
  577.         if (s == littleend)
  578.         return (char *)(big+pos-previous);
  579.     } while (
  580.         pos += screamnext[pos]    /* does this goof up anywhere? */
  581.         );
  582.     }
  583.     else {
  584.     do {
  585.         if (big[pos-previous] != first)
  586.         continue;
  587.         for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
  588.         if (x >= bigend)
  589.             return Nullch;
  590.         if (*s++ != *x++) {
  591.             s--;
  592.             break;
  593.         }
  594.         }
  595.         if (s == littleend)
  596.         return (char *)(big+pos-previous);
  597.     } while ( pos += screamnext[pos] );
  598.     }
  599. #else /* !POINTERRIGOR */
  600.     big -= previous;
  601.     if (SvCASEFOLD(littlestr)) {    /* case insignificant? */
  602.     do {
  603.         if (big[pos] != first && big[pos] != fold[first])
  604.         continue;
  605.         for (x=big+pos+1,s=little; s < littleend; /**/ ) {
  606.         if (x >= bigend)
  607.             return Nullch;
  608.         if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
  609.             s--;
  610.             break;
  611.         }
  612.         }
  613.         if (s == littleend)
  614.         return (char *)(big+pos);
  615.     } while (
  616.         pos += screamnext[pos]    /* does this goof up anywhere? */
  617.         );
  618.     }
  619.     else {
  620.     do {
  621.         if (big[pos] != first)
  622.         continue;
  623.         for (x=big+pos+1,s=little; s < littleend; /**/ ) {
  624.         if (x >= bigend)
  625.             return Nullch;
  626.         if (*s++ != *x++) {
  627.             s--;
  628.             break;
  629.         }
  630.         }
  631.         if (s == littleend)
  632.         return (char *)(big+pos);
  633.     } while (
  634.         pos += screamnext[pos]
  635.         );
  636.     }
  637. #endif /* POINTERRIGOR */
  638.     return Nullch;
  639. }
  640.  
  641. I32
  642. ibcmp(a,b,len)
  643. register U8 *a;
  644. register U8 *b;
  645. register I32 len;
  646. {
  647.     while (len--) {
  648.     if (*a == *b) {
  649.         a++,b++;
  650.         continue;
  651.     }
  652.     if (fold[*a++] == *b++)
  653.         continue;
  654.     return 1;
  655.     }
  656.     return 0;
  657. }
  658.  
  659. /* copy a string to a safe spot */
  660.  
  661. char *
  662. savepv(sv)
  663. char *sv;
  664. {
  665.     register char *newaddr;
  666.  
  667.     New(902,newaddr,strlen(sv)+1,char);
  668.     (void)strcpy(newaddr,sv);
  669.     return newaddr;
  670. }
  671.  
  672. /* same thing but with a known length */
  673.  
  674. char *
  675. savepvn(sv, len)
  676. char *sv;
  677. register I32 len;
  678. {
  679.     register char *newaddr;
  680.  
  681.     New(903,newaddr,len+1,char);
  682.     Copy(sv,newaddr,len,char);        /* might not be null terminated */
  683.     newaddr[len] = '\0';        /* is now */
  684.     return newaddr;
  685. }
  686.  
  687. #if !defined(I_STDARG) && !defined(I_VARARGS)
  688.  
  689. /*
  690.  * Fallback on the old hackers way of doing varargs
  691.  */
  692.  
  693. /*VARARGS1*/
  694. char *
  695. mess(pat,a1,a2,a3,a4)
  696. char *pat;
  697. long a1, a2, a3, a4;
  698. {
  699.     char *s;
  700.     I32 usermess = strEQ(pat,"%s");
  701.     SV *tmpstr;
  702.  
  703.     s = buf;
  704.     if (usermess) {
  705.     tmpstr = sv_newmortal();
  706.     sv_setpv(tmpstr, (char*)a1);
  707.     *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
  708.     }
  709.     else {
  710.     (void)sprintf(s,pat,a1,a2,a3,a4);
  711.     s += strlen(s);
  712.     }
  713.  
  714.     if (s[-1] != '\n') {
  715.     if (dirty)
  716.         strcpy(s, " during global destruction.\n");
  717.     else {
  718.         if (curcop->cop_line) {
  719.         (void)sprintf(s," at %s line %ld",
  720.           SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
  721.         s += strlen(s);
  722.         }
  723.         if (GvIO(last_in_gv) &&
  724.         IoLINES(GvIOp(last_in_gv)) ) {
  725.         (void)sprintf(s,", <%s> %s %ld",
  726.           last_in_gv == argvgv ? "" : GvENAME(last_in_gv),
  727.           strEQ(rs,"\n") ? "line" : "chunk",
  728.           (long)IoLINES(GvIOp(last_in_gv)));
  729.         s += strlen(s);
  730.         }
  731.         (void)strcpy(s,".\n");
  732.     }
  733.     if (usermess)
  734.         sv_catpv(tmpstr,buf+1);
  735.     }
  736.     if (usermess)
  737.     return SvPVX(tmpstr);
  738.     else
  739.     return buf;
  740. }
  741.  
  742. /*VARARGS1*/
  743. void croak(pat,a1,a2,a3,a4)
  744. char *pat;
  745. long a1, a2, a3, a4;
  746. {
  747.     char *tmps;
  748.     char *message;
  749.     HV *stash;
  750.     GV *gv;
  751.     CV *cv;
  752.  
  753.     message = mess(pat,a1,a2,a3,a4);
  754.     if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
  755.     dSP;
  756.  
  757.     PUSHMARK(sp);
  758.     EXTEND(sp, 1);
  759.     PUSHs(sv_2mortal(newSVpv(message,0)));
  760.     PUTBACK;
  761.     perl_call_sv((SV*)cv, G_DISCARD);
  762.     }
  763.     if (in_eval) {
  764.     restartop = die_where(message);
  765.     longjmp(top_env, 3);
  766.     }
  767.     fputs(message,stderr);
  768.     (void)fflush(stderr);
  769.     if (e_fp)
  770.     (void)UNLINK(e_tmpname);
  771.     statusvalue = SHIFTSTATUS(statusvalue);
  772. #ifdef VMS
  773.     my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
  774. #else
  775.     my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
  776. #endif
  777. }
  778.  
  779. /*VARARGS1*/
  780. void warn(pat,a1,a2,a3,a4)
  781. char *pat;
  782. long a1, a2, a3, a4;
  783. {
  784.     char *message;
  785.     SV *sv;
  786.     HV *stash;
  787.     GV *gv;
  788.     CV *cv;
  789.  
  790.     message = mess(pat,a1,a2,a3,a4);
  791.     if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
  792.     dSP;
  793.  
  794.     PUSHMARK(sp);
  795.     EXTEND(sp, 1);
  796.     PUSHs(sv_2mortal(newSVpv(message,0)));
  797.     PUTBACK;
  798.     perl_call_sv((SV*)cv, G_DISCARD);
  799.     }
  800.     else {
  801.     fputs(message,stderr);
  802. #ifdef LEAKTEST
  803.     DEBUG_L(xstat());
  804. #endif
  805.     (void)fflush(stderr);
  806.     }
  807. }
  808.  
  809. #else /* !defined(I_STDARG) && !defined(I_VARARGS) */
  810.  
  811. #ifdef I_STDARG
  812. char *
  813. mess(char *pat, va_list *args)
  814. #else
  815. /*VARARGS0*/
  816. char *
  817. mess(pat, args)
  818.     char *pat;
  819.     va_list *args;
  820. #endif
  821. {
  822.     char *s;
  823.     SV *tmpstr;
  824.     I32 usermess;
  825. #ifndef HAS_VPRINTF
  826. #ifdef USE_CHAR_VSPRINTF
  827.     char *vsprintf();
  828. #else
  829.     I32 vsprintf();
  830. #endif
  831. #endif
  832.  
  833.     s = buf;
  834.     usermess = strEQ(pat, "%s");
  835.     if (usermess) {
  836.     tmpstr = sv_newmortal();
  837.     sv_setpv(tmpstr, va_arg(*args, char *));
  838.     *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
  839.     }
  840.     else {
  841.     (void) vsprintf(s,pat,*args);
  842.     s += strlen(s);
  843.     }
  844.     va_end(*args);
  845.  
  846.     if (s[-1] != '\n') {
  847.     if (dirty)
  848.         strcpy(s, " during global destruction.\n");
  849.     else {
  850.         if (curcop->cop_line) {
  851.         (void)sprintf(s," at %s line %ld",
  852.           SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
  853.         s += strlen(s);
  854.         }
  855.         if (GvIO(last_in_gv) &&
  856.         IoLINES(GvIOp(last_in_gv)) ) {
  857.         (void)sprintf(s,", <%s> %s %ld",
  858.           last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
  859.           strEQ(rs,"\n") ? "line" : "chunk",
  860.           (long)IoLINES(GvIOp(last_in_gv)));
  861.         s += strlen(s);
  862.         }
  863.         (void)strcpy(s,".\n");
  864.     }
  865.     if (usermess)
  866.         sv_catpv(tmpstr,buf+1);
  867.     }
  868.  
  869.     if (usermess)
  870.     return SvPVX(tmpstr);
  871.     else
  872.     return buf;
  873. }
  874.  
  875. #ifdef I_STDARG
  876. void
  877. croak(char* pat, ...)
  878. #else
  879. /*VARARGS0*/
  880. void
  881. croak(pat, va_alist)
  882.     char *pat;
  883.     va_dcl
  884. #endif
  885. {
  886.     va_list args;
  887.     char *message;
  888.     HV *stash;
  889.     GV *gv;
  890.     CV *cv;
  891.  
  892. #ifdef I_STDARG
  893.     va_start(args, pat);
  894. #else
  895.     va_start(args);
  896. #endif
  897.     message = mess(pat, &args);
  898.     va_end(args);
  899.     if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
  900.     dSP;
  901.  
  902.     PUSHMARK(sp);
  903.     EXTEND(sp, 1);
  904.     PUSHs(sv_2mortal(newSVpv(message,0)));
  905.     PUTBACK;
  906.     perl_call_sv((SV*)cv, G_DISCARD);
  907.     }
  908.     if (in_eval) {
  909.     restartop = die_where(message);
  910.     longjmp(top_env, 3);
  911.     }
  912.     fputs(message,stderr);
  913.     (void)fflush(stderr);
  914.     if (e_fp)
  915.     (void)UNLINK(e_tmpname);
  916.     statusvalue = SHIFTSTATUS(statusvalue);
  917. #ifdef VMS
  918.     my_exit((U32)(vaxc$errno?vaxc$errno:(statusvalue?statusvalue:44)));
  919. #else
  920.     my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
  921. #endif
  922. }
  923.  
  924. void
  925. #ifdef I_STDARG
  926. warn(char* pat,...)
  927. #else
  928. /*VARARGS0*/
  929. warn(pat,va_alist)
  930.     char *pat;
  931.     va_dcl
  932. #endif
  933. {
  934.     va_list args;
  935.     char *message;
  936.     HV *stash;
  937.     GV *gv;
  938.     CV *cv;
  939.  
  940. #ifdef I_STDARG
  941.     va_start(args, pat);
  942. #else
  943.     va_start(args);
  944. #endif
  945.     message = mess(pat, &args);
  946.     va_end(args);
  947.  
  948.     if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
  949.     dSP;
  950.  
  951.     PUSHMARK(sp);
  952.     EXTEND(sp, 1);
  953.     PUSHs(sv_2mortal(newSVpv(message,0)));
  954.     PUTBACK;
  955.     perl_call_sv((SV*)cv, G_DISCARD);
  956.     }
  957.     else {
  958.     fputs(message,stderr);
  959. #ifdef LEAKTEST
  960.     DEBUG_L(xstat());
  961. #endif
  962.     (void)fflush(stderr);
  963.     }
  964. }
  965. #endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
  966.  
  967. #if !defined(VMS) && !defined(RISCOS)  /* VMS' my_setenv() is in VMS.c */
  968. void                    /* RISC OS one is in acorn.c */
  969. my_setenv(nam,val)
  970. char *nam, *val;
  971. {
  972.     register I32 i=setenv_getix(nam);        /* where does it go? */
  973.  
  974.     if (environ == origenviron) {    /* need we copy environment? */
  975.     I32 j;
  976.     I32 max;
  977.     char **tmpenv;
  978.  
  979.     /*SUPPRESS 530*/
  980.     for (max = i; environ[max]; max++) ;
  981.     New(901,tmpenv, max+2, char*);
  982.     for (j=0; j<max; j++)        /* copy environment */
  983.         tmpenv[j] = savepv(environ[j]);
  984.     tmpenv[max] = Nullch;
  985.     environ = tmpenv;        /* tell exec where it is now */
  986.     }
  987.     if (!val) {
  988.     while (environ[i]) {
  989.         environ[i] = environ[i+1];
  990.         i++;
  991.     }
  992.     return;
  993.     }
  994.     if (!environ[i]) {            /* does not exist yet */
  995.     Renew(environ, i+2, char*);    /* just expand it a bit */
  996.     environ[i+1] = Nullch;    /* make sure it's null terminated */
  997.     }
  998.     else
  999.     Safefree(environ[i]);
  1000.     New(904, environ[i], strlen(nam) + strlen(val) + 2, char);
  1001. #ifndef MSDOS
  1002.     (void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
  1003. #else
  1004.     /* MS-DOS requires environment variable names to be in uppercase */
  1005.     /* [Tom Dinger, 27 August 1990: Well, it doesn't _require_ it, but
  1006.      * some utilities and applications may break because they only look
  1007.      * for upper case strings. (Fixed strupr() bug here.)]
  1008.      */
  1009.     strcpy(environ[i],nam); strupr(environ[i]);
  1010.     (void)sprintf(environ[i] + strlen(nam),"=%s",val);
  1011. #endif /* MSDOS */
  1012. }
  1013.  
  1014. I32
  1015. setenv_getix(nam)
  1016. char *nam;
  1017. {
  1018.     register I32 i, len = strlen(nam);
  1019.  
  1020.     for (i = 0; environ[i]; i++) {
  1021.     if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
  1022.         break;            /* strnEQ must come first to avoid */
  1023.     }                    /* potential SEGV's */
  1024.     return i;
  1025. }
  1026. #endif /* !VMS && !RISCOS*/
  1027.  
  1028. #ifdef EUNICE
  1029. I32
  1030. unlnk(f)    /* unlink all versions of a file */
  1031. char *f;
  1032. {
  1033.     I32 i;
  1034.  
  1035.     for (i = 0; unlink(f) >= 0; i++) ;
  1036.     return i ? 0 : -1;
  1037. }
  1038. #endif
  1039.  
  1040. #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
  1041. char *
  1042. my_bcopy(from,to,len)
  1043. register char *from;
  1044. register char *to;
  1045. register I32 len;
  1046. {
  1047.     char *retval = to;
  1048.  
  1049.     if (from - to >= 0) {
  1050.     while (len--)
  1051.         *to++ = *from++;
  1052.     }
  1053.     else {
  1054.     to += len;
  1055.     from += len;
  1056.     while (len--)
  1057.         *(--to) = *(--from);
  1058.     }
  1059.     return retval;
  1060. }
  1061. #endif
  1062.  
  1063. #if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
  1064. char *
  1065. my_bzero(loc,len)
  1066. register char *loc;
  1067. register I32 len;
  1068. {
  1069.     char *retval = loc;
  1070.  
  1071.     while (len--)
  1072.     *loc++ = 0;
  1073.     return retval;
  1074. }
  1075. #endif
  1076.  
  1077. #ifndef HAS_MEMCMP
  1078. I32
  1079. my_memcmp(s1,s2,len)
  1080. register unsigned char *s1;
  1081. register unsigned char *s2;
  1082. register I32 len;
  1083. {
  1084.     register I32 tmp;
  1085.  
  1086.     while (len--) {
  1087.     if (tmp = *s1++ - *s2++)
  1088.         return tmp;
  1089.     }
  1090.     return 0;
  1091. }
  1092. #endif /* HAS_MEMCMP */
  1093.  
  1094. #ifdef I_VARARGS
  1095. #ifndef HAS_VPRINTF
  1096.  
  1097. #ifdef USE_CHAR_VSPRINTF
  1098. char *
  1099. #else
  1100. int
  1101. #endif
  1102. vsprintf(dest, pat, args)
  1103. char *dest, *pat, *args;
  1104. {
  1105.     FILE fakebuf;
  1106.  
  1107.     fakebuf._ptr = dest;
  1108.     fakebuf._cnt = 32767;
  1109. #ifndef _IOSTRG
  1110. #define _IOSTRG 0
  1111. #endif
  1112.     fakebuf._flag = _IOWRT|_IOSTRG;
  1113.     _doprnt(pat, args, &fakebuf);    /* what a kludge */
  1114.     (void)putc('\0', &fakebuf);
  1115. #ifdef USE_CHAR_VSPRINTF
  1116.     return(dest);
  1117. #else
  1118.     return 0;        /* perl doesn't use return value */
  1119. #endif
  1120. }
  1121.  
  1122. int
  1123. vfprintf(fd, pat, args)
  1124. FILE *fd;
  1125. char *pat, *args;
  1126. {
  1127.     _doprnt(pat, args, fd);
  1128.     return 0;        /* wrong, but perl doesn't use the return value */
  1129. }
  1130. #endif /* HAS_VPRINTF */
  1131. #endif /* I_VARARGS */
  1132.  
  1133. #ifdef MYSWAP
  1134. #if BYTEORDER != 0x4321
  1135. short
  1136. #ifndef CAN_PROTOTYPE
  1137. my_swap(s)
  1138. short s;
  1139. #else
  1140. my_swap(short s)
  1141. #endif
  1142. {
  1143. #if (BYTEORDER & 1) == 0
  1144.     short result;
  1145.  
  1146.     result = ((s & 255) << 8) + ((s >> 8) & 255);
  1147.     return result;
  1148. #else
  1149.     return s;
  1150. #endif
  1151. }
  1152.  
  1153. long
  1154. #ifndef CAN_PROTOTYPE
  1155. my_htonl(l)
  1156. register long l;
  1157. #else
  1158. my_htonl(long l)
  1159. #endif
  1160. {
  1161.     union {
  1162.     long result;
  1163.     char c[sizeof(long)];
  1164.     } u;
  1165.  
  1166. #if BYTEORDER == 0x1234
  1167.     u.c[0] = (l >> 24) & 255;
  1168.     u.c[1] = (l >> 16) & 255;
  1169.     u.c[2] = (l >> 8) & 255;
  1170.     u.c[3] = l & 255;
  1171.     return u.result;
  1172. #else
  1173. #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
  1174.     croak("Unknown BYTEORDER\n");
  1175. #else
  1176.     register I32 o;
  1177.     register I32 s;
  1178.  
  1179.     for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
  1180.     u.c[o & 0xf] = (l >> s) & 255;
  1181.     }
  1182.     return u.result;
  1183. #endif
  1184. #endif
  1185. }
  1186.  
  1187. long
  1188. #ifndef CAN_PROTOTYPE
  1189. my_ntohl(l)
  1190. register long l;
  1191. #else
  1192. my_ntohl(long l)
  1193. #endif
  1194. {
  1195.     union {
  1196.     long l;
  1197.     char c[sizeof(long)];
  1198.     } u;
  1199.  
  1200. #if BYTEORDER == 0x1234
  1201.     u.c[0] = (l >> 24) & 255;
  1202.     u.c[1] = (l >> 16) & 255;
  1203.     u.c[2] = (l >> 8) & 255;
  1204.     u.c[3] = l & 255;
  1205.     return u.l;
  1206. #else
  1207. #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
  1208.     croak("Unknown BYTEORDER\n");
  1209. #else
  1210.     register I32 o;
  1211.     register I32 s;
  1212.  
  1213.     u.l = l;
  1214.     l = 0;
  1215.     for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
  1216.     l |= (u.c[o & 0xf] & 255) << s;
  1217.     }
  1218.     return l;
  1219. #endif
  1220. #endif
  1221. }
  1222.  
  1223. #endif /* BYTEORDER != 0x4321 */
  1224. #endif /* MYSWAP */
  1225.  
  1226. /*
  1227.  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
  1228.  * If these functions are defined,
  1229.  * the BYTEORDER is neither 0x1234 nor 0x4321.
  1230.  * However, this is not assumed.
  1231.  * -DWS
  1232.  */
  1233.  
  1234. #define HTOV(name,type)                        \
  1235.     type                            \
  1236.     name (n)                        \
  1237.     register type n;                    \
  1238.     {                            \
  1239.         union {                        \
  1240.         type value;                    \
  1241.         char c[sizeof(type)];                \
  1242.         } u;                        \
  1243.         register I32 i;                    \
  1244.         register I32 s;                    \
  1245.         for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {    \
  1246.         u.c[i] = (n >> s) & 0xFF;            \
  1247.         }                            \
  1248.         return u.value;                    \
  1249.     }
  1250.  
  1251. #define VTOH(name,type)                        \
  1252.     type                            \
  1253.     name (n)                        \
  1254.     register type n;                    \
  1255.     {                            \
  1256.         union {                        \
  1257.         type value;                    \
  1258.         char c[sizeof(type)];                \
  1259.         } u;                        \
  1260.         register I32 i;                    \
  1261.         register I32 s;                    \
  1262.         u.value = n;                    \
  1263.         n = 0;                        \
  1264.         for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {    \
  1265.         n += (u.c[i] & 0xFF) << s;            \
  1266.         }                            \
  1267.         return n;                        \
  1268.     }
  1269.  
  1270. #if defined(HAS_HTOVS) && !defined(htovs)
  1271. HTOV(htovs,short)
  1272. #endif
  1273. #if defined(HAS_HTOVL) && !defined(htovl)
  1274. HTOV(htovl,long)
  1275. #endif
  1276. #if defined(HAS_VTOHS) && !defined(vtohs)
  1277. VTOH(vtohs,short)
  1278. #endif
  1279. #if defined(HAS_VTOHL) && !defined(vtohl)
  1280. VTOH(vtohl,long)
  1281. #endif
  1282.  
  1283. #if  !defined(DOSISH) && !defined(VMS)  && !defined(RISCOS)/* VMS' my_popen() is in VMS.c */
  1284. FILE *
  1285. my_popen(cmd,mode)
  1286. char    *cmd;
  1287. char    *mode;
  1288. {
  1289.     int p[2];
  1290.     register I32 this, that;
  1291.     register I32 pid;
  1292.     SV *sv;
  1293.     I32 doexec = strNE(cmd,"-");
  1294.  
  1295.     if (pipe(p) < 0)
  1296.     return Nullfp;
  1297.     this = (*mode == 'w');
  1298.     that = !this;
  1299.     if (tainting) {
  1300.     if (doexec) {
  1301.         taint_env();
  1302.         taint_proper("Insecure %s%s", "EXEC");
  1303.     }
  1304.     }
  1305.     while ((pid = (doexec?vfork():fork())) < 0) {
  1306.     if (errno != EAGAIN) {
  1307.         close(p[this]);
  1308.         if (!doexec)
  1309.         croak("Can't fork");
  1310.         return Nullfp;
  1311.     }
  1312.     sleep(5);
  1313.     }
  1314.     if (pid == 0) {
  1315.     GV* tmpgv;
  1316.  
  1317. #define THIS that
  1318. #define THAT this
  1319.     close(p[THAT]);
  1320.     if (p[THIS] != (*mode == 'r')) {
  1321.         dup2(p[THIS], *mode == 'r');
  1322.         close(p[THIS]);
  1323.     }
  1324.     if (doexec) {
  1325. #if !defined(HAS_FCNTL) || !defined(F_SETFD)
  1326.         int fd;
  1327.  
  1328. #ifndef NOFILE
  1329. #define NOFILE 20
  1330. #endif
  1331.         for (fd = maxsysfd + 1; fd < NOFILE; fd++)
  1332.         close(fd);
  1333. #endif
  1334.         do_exec(cmd);    /* may or may not use the shell */
  1335.         _exit(1);
  1336.     }
  1337.     /*SUPPRESS 560*/
  1338.     if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
  1339.         sv_setiv(GvSV(tmpgv),(I32)getpid());
  1340.     forkprocess = 0;
  1341.     hv_clear(pidstatus);    /* we have no children */
  1342.     return Nullfp;
  1343. #undef THIS
  1344. #undef THAT
  1345.     }
  1346.     do_execfree();    /* free any memory malloced by child on vfork */
  1347.     close(p[that]);
  1348.     if (p[that] < p[this]) {
  1349.     dup2(p[this], p[that]);
  1350.     close(p[this]);
  1351.     p[this] = p[that];
  1352.     }
  1353.     sv = *av_fetch(fdpid,p[this],TRUE);
  1354.     (void)SvUPGRADE(sv,SVt_IV);
  1355.     SvIVX(sv) = pid;
  1356.     forkprocess = pid;
  1357.     return fdopen(p[this], mode);
  1358. }
  1359. #else
  1360. #ifdef atarist
  1361. FILE *popen();
  1362. FILE *
  1363. my_popen(cmd,mode)
  1364. char    *cmd;
  1365. char    *mode;
  1366. {
  1367.     return popen(cmd, mode);
  1368. }
  1369. #endif
  1370.  
  1371. #endif /* !DOSISH */
  1372.  
  1373. #ifdef DUMP_FDS
  1374. dump_fds(s)
  1375. char *s;
  1376. {
  1377.     int fd;
  1378.     struct stat tmpstatbuf;
  1379.  
  1380.     fprintf(stderr,"%s", s);
  1381.     for (fd = 0; fd < 32; fd++) {
  1382.     if (Fstat(fd,&tmpstatbuf) >= 0)
  1383.         fprintf(stderr," %d",fd);
  1384.     }
  1385.     fprintf(stderr,"\n");
  1386. }
  1387. #endif
  1388.  
  1389. #ifndef RISCOS
  1390. #ifndef HAS_DUP2
  1391. int
  1392. dup2(oldfd,newfd)
  1393. int oldfd;
  1394. int newfd;
  1395. {
  1396. #if defined(HAS_FCNTL) && defined(F_DUPFD)
  1397.     if (oldfd == newfd)
  1398.     return oldfd;
  1399.     close(newfd);
  1400.     return fcntl(oldfd, F_DUPFD, newfd);
  1401. #else
  1402.     int fdtmp[256];
  1403.     I32 fdx = 0;
  1404.     int fd;
  1405.  
  1406.     if (oldfd == newfd)
  1407.     return oldfd;
  1408.     close(newfd);
  1409.     while ((fd = dup(oldfd)) != newfd && fd >= 0) /* good enough for low fd's */
  1410.     fdtmp[fdx++] = fd;
  1411.     while (fdx > 0)
  1412.     close(fdtmp[--fdx]);
  1413.     return fd;
  1414. #endif
  1415. }
  1416. #endif
  1417. #endif
  1418.  
  1419. #if !defined(DOSISH) && !defined(RISCOS)
  1420. #ifndef VMS /* VMS' my_pclose() is in VMS.c */
  1421. I32
  1422. my_pclose(ptr)
  1423. FILE *ptr;
  1424. {
  1425.     Signal_t (*hstat)(), (*istat)(), (*qstat)();
  1426.     int status;
  1427.     SV **svp;
  1428.     int pid;
  1429.  
  1430.     svp = av_fetch(fdpid,fileno(ptr),TRUE);
  1431.     pid = (int)SvIVX(*svp);
  1432.     SvREFCNT_dec(*svp);
  1433.     *svp = &sv_undef;
  1434.     fclose(ptr);
  1435. #ifdef UTS
  1436.     if(kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
  1437. #endif
  1438.     hstat = signal(SIGHUP, SIG_IGN);
  1439.     istat = signal(SIGINT, SIG_IGN);
  1440.     qstat = signal(SIGQUIT, SIG_IGN);
  1441.     do {
  1442.     pid = wait4pid(pid, &status, 0);
  1443.     } while (pid == -1 && errno == EINTR);
  1444.     signal(SIGHUP, hstat);
  1445.     signal(SIGINT, istat);
  1446.     signal(SIGQUIT, qstat);
  1447.     return(pid < 0 ? pid : status);
  1448. }
  1449. #endif /* !VMS */
  1450. I32
  1451. wait4pid(pid,statusp,flags)
  1452. int pid;
  1453. int *statusp;
  1454. int flags;
  1455. {
  1456.     SV *sv;
  1457.     SV** svp;
  1458.     char spid[16];
  1459.  
  1460.     if (!pid)
  1461.     return -1;
  1462.     if (pid > 0) {
  1463.     sprintf(spid, "%d", pid);
  1464.     svp = hv_fetch(pidstatus,spid,strlen(spid),FALSE);
  1465.     if (svp && *svp != &sv_undef) {
  1466.         *statusp = SvIVX(*svp);
  1467.         (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
  1468.         return pid;
  1469.     }
  1470.     }
  1471.     else {
  1472.     HE *entry;
  1473.  
  1474.     hv_iterinit(pidstatus);
  1475.     if (entry = hv_iternext(pidstatus)) {
  1476.         pid = atoi(hv_iterkey(entry,(I32*)statusp));
  1477.         sv = hv_iterval(pidstatus,entry);
  1478.         *statusp = SvIVX(sv);
  1479.         sprintf(spid, "%d", pid);
  1480.         (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
  1481.         return pid;
  1482.     }
  1483.     }
  1484. #ifdef HAS_WAITPID
  1485.     return waitpid(pid,statusp,flags);
  1486. #else
  1487. #ifdef HAS_WAIT4
  1488.     return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
  1489. #else
  1490.     {
  1491.     I32 result;
  1492.     if (flags)
  1493.         croak("Can't do waitpid with flags");
  1494.     else {
  1495.         while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
  1496.         pidgone(result,*statusp);
  1497.         if (result < 0)
  1498.         *statusp = -1;
  1499.     }
  1500.     return result;
  1501.     }
  1502. #endif
  1503. #endif
  1504. }
  1505. #endif /* !DOSISH */
  1506.  
  1507. void
  1508. /*SUPPRESS 590*/
  1509. pidgone(pid,status)
  1510. int pid;
  1511. int status;
  1512. {
  1513.     register SV *sv;
  1514.     char spid[16];
  1515.  
  1516.     sprintf(spid, "%d", pid);
  1517.     sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE);
  1518.     (void)SvUPGRADE(sv,SVt_IV);
  1519.     SvIVX(sv) = status;
  1520.     return;
  1521. }
  1522.  
  1523. #ifdef atarist
  1524. int pclose();
  1525. I32
  1526. my_pclose(ptr)
  1527. FILE *ptr;
  1528. {
  1529.     return pclose(ptr);
  1530. }
  1531. #endif
  1532.  
  1533. void
  1534. repeatcpy(to,from,len,count)
  1535. register char *to;
  1536. register char *from;
  1537. I32 len;
  1538. register I32 count;
  1539. {
  1540.     register I32 todo;
  1541.     register char *frombase = from;
  1542.  
  1543.     if (len == 1) {
  1544.     todo = *from;
  1545.     while (count-- > 0)
  1546.         *to++ = todo;
  1547.     return;
  1548.     }
  1549.     while (count-- > 0) {
  1550.     for (todo = len; todo > 0; todo--) {
  1551.         *to++ = *from++;
  1552.     }
  1553.     from = frombase;
  1554.     }
  1555. }
  1556.  
  1557. #ifndef CASTNEGFLOAT
  1558. U32
  1559. cast_ulong(f)
  1560. double f;
  1561. {
  1562.     long along;
  1563.  
  1564. #if CASTFLAGS & 2
  1565. #   define BIGDOUBLE 2147483648.0
  1566.     if (f >= BIGDOUBLE)
  1567.     return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000;
  1568. #endif
  1569.     if (f >= 0.0)
  1570.     return (unsigned long)f;
  1571.     along = (long)f;
  1572.     return (unsigned long)along;
  1573. }
  1574. # undef BIGDOUBLE
  1575. #endif
  1576.  
  1577. #ifndef CASTI32
  1578. I32
  1579. cast_i32(f)
  1580. double f;
  1581. {
  1582. #   define BIGDOUBLE 2147483648.0        /* Assume 32 bit int's ! */
  1583. #   define BIGNEGDOUBLE (-2147483648.0)
  1584.     if (f >= BIGDOUBLE)
  1585.     return (I32)fmod(f, BIGDOUBLE);
  1586.     if (f <= BIGNEGDOUBLE)
  1587.     return (I32)fmod(f, BIGNEGDOUBLE);
  1588.     return (I32) f;
  1589. }
  1590. # undef BIGDOUBLE
  1591. # undef BIGNEGDOUBLE
  1592.  
  1593. IV
  1594. cast_iv(f)
  1595. double f;
  1596. {
  1597.     /* XXX  This should be fixed.  It assumes 32 bit IV's. */
  1598. #   define BIGDOUBLE 2147483648.0        /* Assume 32 bit IV's ! */
  1599. #   define BIGNEGDOUBLE (-2147483648.0)
  1600.     if (f >= BIGDOUBLE)
  1601.     return (IV)fmod(f, BIGDOUBLE);
  1602.     if (f <= BIGNEGDOUBLE)
  1603.     return (IV)fmod(f, BIGNEGDOUBLE);
  1604.     return (IV) f;
  1605. }
  1606. # undef BIGDOUBLE
  1607. # undef BIGNEGDOUBLE
  1608. #endif
  1609.  
  1610. #ifndef HAS_RENAME
  1611. I32
  1612. same_dirent(a,b)
  1613. char *a;
  1614. char *b;
  1615. {
  1616.     char *fa = strrchr(a,'/');
  1617.     char *fb = strrchr(b,'/');
  1618.     struct stat tmpstatbuf1;
  1619.     struct stat tmpstatbuf2;
  1620. #ifndef MAXPATHLEN
  1621. #define MAXPATHLEN 1024
  1622. #endif
  1623.     char tmpbuf[MAXPATHLEN+1];
  1624.  
  1625.     if (fa)
  1626.     fa++;
  1627.     else
  1628.     fa = a;
  1629.     if (fb)
  1630.     fb++;
  1631.     else
  1632.     fb = b;
  1633.     if (strNE(a,b))
  1634.     return FALSE;
  1635.     if (fa == a)
  1636.     strcpy(tmpbuf,".");
  1637.     else
  1638.     strncpy(tmpbuf, a, fa - a);
  1639.     if (Stat(tmpbuf, &tmpstatbuf1) < 0)
  1640.     return FALSE;
  1641.     if (fb == b)
  1642.     strcpy(tmpbuf,".");
  1643.     else
  1644.     strncpy(tmpbuf, b, fb - b);
  1645.     if (Stat(tmpbuf, &tmpstatbuf2) < 0)
  1646.     return FALSE;
  1647.     return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
  1648.        tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;
  1649. }
  1650. #endif /* !HAS_RENAME */
  1651.  
  1652. unsigned long
  1653. scan_oct(start, len, retlen)
  1654. char *start;
  1655. I32 len;
  1656. I32 *retlen;
  1657. {
  1658.     register char *s = start;
  1659.     register unsigned long retval = 0;
  1660.  
  1661.     while (len && *s >= '0' && *s <= '7') {
  1662.     retval <<= 3;
  1663.     retval |= *s++ - '0';
  1664.     len--;
  1665.     }
  1666.     if (dowarn && len && (*s == '8' || *s == '9'))
  1667.     warn("Illegal octal digit ignored");
  1668.     *retlen = s - start;
  1669.     return retval;
  1670. }
  1671.  
  1672. unsigned long
  1673. scan_hex(start, len, retlen)
  1674. char *start;
  1675. I32 len;
  1676. I32 *retlen;
  1677. {
  1678.     register char *s = start;
  1679.     register unsigned long retval = 0;
  1680.     char *tmp;
  1681.  
  1682.     while (len-- && *s && (tmp = strchr(hexdigit, *s))) {
  1683.     retval <<= 4;
  1684.     retval |= (tmp - hexdigit) & 15;
  1685.     s++;
  1686.     }
  1687.     *retlen = s - start;
  1688.     return retval;
  1689. }
  1690.  
  1691. /* Amazingly enough, some systems (e.g. Dynix 3) don't have fmod.
  1692.    This is a slow, stupid, but working emulation.  (AD)
  1693. */
  1694. #ifdef USE_MY_FMOD
  1695. double
  1696. my_fmod(x, y)
  1697. double x, y;
  1698. {
  1699.     double i = 0.0;   /* Can't use int because it can overflow */
  1700.     if ((x == 0) || (y == 0))
  1701.        return 0;
  1702.     /* The sign of fmod is the same as the sign of x.  */
  1703.     if ( (x < 0 && y > 0) || (x > 0 && y < 0) )
  1704.     y = -y;
  1705.     if (x > 0) {
  1706.     while (x - i*y > y)
  1707.         i++;
  1708.     } else {
  1709.     while (x - i*y < y)
  1710.         i++;
  1711.     }
  1712.     return x - i * y;
  1713. }
  1714. #endif
  1715.